home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0072_Large Virtual Text Screen.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  9KB  |  460 lines
  1. {
  2. > I just let dos write something on the screen, I'm in the normal
  3. > videomode, say that writes 100 lines to the screen. How can I read
  4. > whatever that program wrote if the lines have scrolled of the screen ???
  5. > I need to have the output in an array ... with the colors ... there might
  6. > even be an animation in the output (ansi) ... I know how to put a normal
  7. > 25x80 in an array or a 50x80 ... but how do you work with something
  8. > that's 100 lines long ... I want to be able to scroll back after the
  9. > display ...
  10.  
  11. You can use an Array to do it - or, you can program your graphic-card. :-)
  12.  
  13. Perhaps this little prog will give you a clue:
  14. }
  15.  
  16. program BreakOut;
  17.  
  18. uses CRT, DOS;
  19.  
  20. const
  21.  
  22.  UP   = 0;   { Verschieberichtung fuer Bildschirm. }
  23.  DOWN = 1;
  24.  ST_X = 10;  { Steine nebeneinander. }
  25.  ST_Y = 5;   { Steine uebereinander. }
  26.  
  27. type
  28.  
  29.  screen_params = record
  30.   zeichen  : char;
  31.   attribut : byte;
  32.  end;
  33.  
  34.  Video_params = record
  35.   mode, page     : byte;
  36.   start_scanline : byte;
  37.   end_scanline   : byte;
  38.   row, column    : byte;
  39.  end;
  40.  
  41.  stone_params = record
  42.   spalte : byte;
  43.   zeile  : byte;
  44.  end;
  45.  
  46.  bouncer_params = record  { bouncer == schlaeger }
  47.   spalte : shortint;
  48.   zeile  : shortint;
  49.   dir    : shortint;
  50.   speed  : longint;
  51.   count  : longint;
  52.  end;
  53.  
  54.  ball_params = record
  55.   spalte : real;
  56.   zeile  : real;
  57.   speed  : longint;
  58.   count  : longint;
  59.   dir_x  : real;
  60.   dir_y  : real;
  61.   next_x : real;
  62.   next_y : real;
  63.   last_x : real;
  64.   last_y : real;
  65.   flag   : byte;
  66.  end;
  67.  
  68.  screen_type = array [1..2000] of screen_params;
  69.  
  70. var
  71.  
  72.  regs    : Registers;
  73.  Video   : Video_params;
  74.  bouncer : bouncer_params;
  75.  ball    : ball_params;
  76.  stone   : array [1..ST_X,1..ST_Y] of stone_params;
  77.  screen  : ^screen_type;  { Zeiger auf aktuelle Seite. }
  78.  screen0 : pointer;       { Zeiger auf Seite 0. }
  79.  screen1 : pointer;       { Zeiger auf Seite 1. }
  80.  screen2 : pointer;       { Zeiger auf Seite 2. }
  81.  
  82. procedure GetCurrentVideoMode;
  83. {
  84.  Procedure to get and store the current video mode settings.
  85. }
  86.  
  87. begin
  88.  regs.ah := $0F;
  89.  intr($10, regs);
  90.  Video.mode := regs.al;
  91.  Video.page := regs.bh;
  92. end;
  93.  
  94. procedure GetCurrentCursorSettings;
  95. {
  96.  Procedure to get and store the current cursor settings.
  97. }
  98.  
  99. begin
  100.  regs.ah := 3;
  101.  regs.bh := Video.page;
  102.  intr($10, regs);
  103.  Video.start_scanline := regs.ch;
  104.  Video.end_scanline := regs.cl;
  105.  Video.row := regs.dh;
  106.  Video.column := regs.dl;
  107. end;
  108.  
  109. procedure SetVideoMode(mode : byte);
  110. {
  111.  Procedure to set a specific video mode.
  112.  
  113.  mode = new video mode.
  114. }
  115.  
  116. begin
  117.  regs.ah := 0;
  118.  regs.al := mode;
  119.  intr($10, regs);
  120. end;
  121.  
  122. procedure HideCursor;
  123. {
  124.  Procedure to make the cursor invisible on the screen.
  125. }
  126.  
  127. begin
  128.  regs.ah := 1;
  129.  regs.al := Video.mode;
  130.  regs.cx := $FFFF;
  131.  intr($10, regs);
  132. end;
  133.  
  134. procedure RestoreCursor;
  135. {
  136.  Procedure to restore the old cursor.
  137. }
  138.  
  139. begin
  140.  regs.ah := 1;
  141.  regs.al := Video.mode;
  142.  regs.ch := Video.start_scanline;
  143.  regs.cl := Video.end_scanline;
  144.  intr($10, regs);
  145. end;
  146.  
  147. procedure ClearScreen;
  148.  
  149. var
  150.  
  151.  i : integer;
  152.  
  153. begin
  154.  for i := 1 to 2000 do
  155.  begin
  156.   screen^[i].zeichen := #32;
  157.   screen^[i].attribut := 7;
  158.  end;
  159. end;
  160.  
  161. procedure DrawBorder;
  162.  
  163. var
  164.  
  165.  i : integer;
  166.  
  167. begin
  168.  for i := 1 to 80 do
  169.   screen^[i].attribut := $30;
  170.  for i := 81 to 1920 do  { 1920 = 2000 - 80 }
  171.  begin
  172.   screen^[i].attribut := $30;
  173.   i := i + 79;
  174.   screen^[i].attribut := $30;
  175.  end;
  176. end;
  177.  
  178. procedure InitializeStones;
  179.  
  180. var
  181.  
  182.  i, j : byte;
  183.  x, y : byte;  { x = Spalte; y = Zeile }
  184.  
  185. begin
  186.  y := 4;
  187.  for i := 1 to ST_Y do  { Zeilen }
  188.  begin
  189.   x := 7;
  190.   for j := 1 to ST_X do  { Spalten }
  191.   begin
  192.    stone[j, i].spalte := x;
  193.    stone[j, i].zeile := y;
  194.    x := x + 7;
  195.   end;
  196.   y := y + 2;
  197.  end;
  198. end;
  199.  
  200. procedure DrawStones;
  201.  
  202. var
  203.  
  204.  pos     : integer;
  205.  i, j, k : byte;
  206.  
  207. begin
  208.  for i := 1 to ST_Y do  { Zeilen }
  209.  begin
  210.   for j := 1 to ST_X do  { Spalten }
  211.   begin
  212.    pos := stone[j, i].zeile * 80 + stone[j, i].spalte;
  213.    for k := 0 to 4 do
  214.     screen^[(pos + k)].attribut := $60;
  215.   end;
  216.  end;
  217. end;
  218.  
  219. procedure DrawBouncer;
  220.  
  221. var
  222.  
  223.  i   : integer;
  224.  pos : integer;
  225.  
  226. begin
  227.  pos := bouncer.zeile * 80 + bouncer.spalte - 1;
  228.  screen^[pos].attribut := 7;
  229.  for i := 1 to 8 do
  230.   screen^[(pos + i)].attribut := $70;
  231.  screen^[(pos + 9)].attribut := 7;
  232. end;
  233.  
  234. procedure DrawBall;
  235.  
  236. var
  237.  
  238.  pos : integer;
  239.  
  240. begin
  241.  pos := integer(trunc(ball.last_y) * 80 + trunc(ball.last_x));
  242.  screen^[pos].zeichen := #32;
  243.  screen^[pos].attribut := 7;
  244.  pos := integer(trunc(ball.zeile) * 80 + trunc(ball.spalte));
  245.  screen^[pos].zeichen := 'o';
  246.  screen^[pos].attribut := 5;
  247.  ball.last_x := ball.spalte;
  248.  ball.last_y := ball.zeile;
  249.  ball.next_x := ball.spalte + ball.dir_x;
  250.  ball.next_y := ball.zeile + ball.dir_y;
  251. end;
  252.  
  253. procedure MovePicture(scr : pointer; direction : byte);
  254.  
  255. var
  256.  
  257.  dir     : integer;
  258.  count   : word;
  259.  zaehler : word;
  260.  
  261. begin
  262.  zaehler := ofs(screen^) shr 1;
  263.  port[$03D4] := $0C;
  264.  port[$03D5] := hi(zaehler);
  265.  port[$03D4] := $0D;
  266.  port[$03D5] := lo(zaehler);
  267.  if (direction = UP) then
  268.   dir := 80
  269.  else
  270.   dir := (-80);
  271.  count := 0;
  272.  repeat
  273.   inc(count);
  274.   zaehler := zaehler + dir;
  275.   port[$03D4] := $0C;
  276.   port[$03D5] := hi(zaehler);
  277.   port[$03D4] := $0D;
  278.   port[$03D5] := lo(zaehler);
  279.   delay(20);
  280.  until (count = 25);
  281.  screen := scr;
  282. end;
  283.  
  284. function MoveBouncer : byte;
  285.  
  286. var
  287.  
  288.  c : char;
  289.  
  290. begin
  291.  bouncer.count := bouncer.count - 1;
  292.  if (bouncer.count = 0) then
  293.  begin
  294.   bouncer.count := bouncer.speed;
  295.   if (keypressed) then
  296.   begin
  297.    c := readkey;
  298.    case c of
  299.     #0  : begin
  300.            c := readkey;
  301.            case c of
  302.             #75 : bouncer.dir := (-1);
  303.             #77 : bouncer.dir := 1;
  304.            end;
  305.           end;
  306.     #27 : begin
  307.            MoveBouncer := 1;
  308.            exit;
  309.           end;
  310.     #32 : bouncer.dir := 0;
  311.    end;
  312.   end;
  313.   bouncer.spalte := bouncer.spalte + bouncer.dir;
  314.   if (bouncer.spalte < 2) then
  315.   begin
  316.    bouncer.spalte := 2;
  317.    bouncer.dir := 0;
  318.   end;
  319.   if (bouncer.spalte = 73) then
  320.   begin
  321.    bouncer.spalte := 72;
  322.    bouncer.dir := 0;
  323.   end;
  324.   if (bouncer.dir <> 0) then
  325.    DrawBouncer;
  326.  end;
  327.  MoveBouncer := 0;
  328. end;
  329.  
  330. procedure MoveBall;
  331.  
  332. var
  333.  
  334.  pos    : integer;
  335.  
  336. begin
  337.  ball.count := ball.count - 1;
  338.  if (ball.count = 0) then
  339.  begin
  340.   ball.count := ball.speed;
  341.  
  342.   { Linken und rechten Rand abfragen. }
  343.  
  344.   if ((trunc(ball.next_x) < 2) or (trunc(ball.next_x) > 79)) then
  345.   begin
  346.    ball.dir_x := ball.dir_x * (-1.0);
  347.    ball.next_x := ball.spalte + ball.dir_x;
  348.   end;
  349.  
  350.   { Oberen Rand abfragen. }
  351.  
  352.   if (trunc(ball.next_y) < 1) then
  353.   begin
  354.    ball.dir_y := ball.dir_y * (-1.0);
  355.    ball.next_y := ball.zeile + ball.dir_y;
  356.   end;
  357.  
  358.   { Unteren Rand abfragen. }
  359.  
  360.   if (trunc(ball.next_y) > 23) then
  361.   begin
  362.    pos := integer((trunc(ball.zeile) + 1) * 80 + trunc(ball.spalte));
  363.    if (screen^[pos].attribut = $70) then
  364.    begin
  365.     ball.dir_y := ball.dir_y * (-1.0);
  366.     ball.next_y := ball.zeile + ball.dir_y;
  367.    end
  368.    else
  369.    begin
  370.     ball.flag := 2;
  371.     exit;
  372.    end;
  373.   end;
  374.   ball.spalte := ball.next_x;
  375.   ball.zeile := ball.next_y;
  376.   DrawBall;
  377.  end;
  378. end;
  379.  
  380. procedure Play;
  381.  
  382. var
  383.  
  384.  erg : byte;
  385.  
  386. begin
  387.  while (TRUE) do
  388.  begin
  389.   erg := MoveBouncer;
  390.   if (erg = 1) then
  391.    exit;
  392.   MoveBall;
  393.   if (ball.flag = 2) then
  394.    exit;
  395.  end;
  396. end;
  397.  
  398. begin
  399.  GetCurrentVideoMode;
  400.  GetCurrentCursorSettings;
  401.  if (Video.mode <> 3) then
  402.   SetVideoMode(3);
  403.  HideCursor;
  404.  
  405.  screen0 := ptr($B800, 0000);  { Bildschirmseite 0. }
  406.  screen1 := ptr($B800, 4000);  { Bildschirmseite 1. }
  407.  screen2 := ptr($B800, 8000);  { Bildschirmseite 2. }
  408.  screen := screen0;
  409.  ClearScreen;
  410.  screen := screen2;
  411.  ClearScreen;
  412.  screen := screen1;
  413.  ClearScreen;
  414.  DrawBorder;
  415.  InitializeStones;
  416.  DrawStones;
  417.  bouncer.spalte := 35;
  418.  bouncer.zeile := 24;
  419.  bouncer.dir := 0;
  420.  bouncer.speed := 3000;
  421.  bouncer.count := bouncer.speed;
  422.  DrawBouncer;
  423.  ball.spalte := 40.0;
  424.  ball.zeile := 20.0;
  425.  ball.speed := 8000;
  426.  ball.count := ball.speed;
  427.  ball.dir_x := 1.0;
  428.  ball.dir_y := (-1.0);
  429.  ball.last_x := 39.0;
  430.  ball.last_y := 21.0;
  431.  ball.flag := 0;
  432.  DrawBall;
  433.  screen := screen0;
  434.  repeat
  435.   MovePicture(screen1, UP);
  436.   MovePicture(screen2, UP);
  437.   MovePicture(screen1, DOWN);
  438.   MovePicture(screen0, DOWN);
  439.  until (keypressed);
  440.  
  441.  MovePicture(screen1, UP);
  442.  Play;
  443.  
  444.  RestoreCursor;
  445.  port[$03D4] := $0C;
  446.  port[$03D5] := 0;
  447.  port[$03D4] := $0D;
  448.  port[$03D5] := 0;
  449.  if (Video.mode <> 3) then
  450.   SetVideoMode(Video.mode)
  451.  else
  452.   clrscr;
  453.  textattr := LIGHTGRAY;
  454.  writeln;
  455.  writeln('Thank you for playing BreakOut!');
  456.  writeln;
  457.  writeln('Do have a nice day...');
  458.  writeln; writeln;
  459. end.
  460.